COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	EXPR CHART() 
C00008 00003	EXPR INIT() 
C00011 ENDMK
C⊗;
EXPR CHART() ;
BEGIN
NEW NAME, YEAR, MONTH, DAY, HOUR, ZONE, LATITUDE, LONGITUDE,
    STDTIME, W, GMT, SIDTIMENOON, SIDTIMEG, SIDTIME, SDAY, SGMT,
    SMALLT, MCS, SMALLMCD, ASCS, SMALLASCD, SMALLASCM,
    BIGT, BIGMCD, BIGASCD, BIGASCM,
    PNEXT, PNATAL, PPREV, MC, ASC, S ;
IF NULL('JANUARY.MONTH) THEN INIT() ;
CHOICE(10) ;

PRINTSTR("IN CASE OF TYPO, MAKE NEXT RESPONSE `NIL'") ;
NAME ← RD("NAME") ;
YEAR ← RD("YEAR") ;
DO BEGIN MONTH ← RD("MONTH") ;
   IF NOT NUMBERP MONTH THEN MONTH ← MONTH.MONTH ;
   END
UNTIL NUMBERP MONTH ;
DAY ← RD("DAY OF THE MONTH") ;
HOUR ← RD("TIME, E.G., 1745 FOR 5:45PM") ;
DO	BEGIN
	ZONE ← RD("TIME ZONE, E.G., (PACIFIC DAYLIGHT WAR)") ;
	W ← (CAR ZONE).WESTOFGREENWICH ;
	IF NOT NUMBERP W THEN PRINTSTR("NO SUCH ZONE " CAT CAR(ZONE)) ;
	END UNTIL NUMBERP W ;
LATITUDE ← RD("LATITUDE, DEGREES NORTH") ;
LONGITUDE ← RD("LONGITUDE, DEGREES WEST") ;
TERPRI PRINC(<NAME, HOUR, <DAY, MONTHS[MONTH], YEAR>, ZONE,
   LATITUDE, 'N, LONGITUDE, 'W>) ;
%MINUTES AFTER MIDNIGHT FROM HERE ON, EXCEPT SECONDS FOR SIDEREAL TIME%
STDTIME ← MINS(HOUR) - ZONECORRECTION(ZONE) ;
GMT ← STDTIME + 60*W ;
TERPRI PRINC(<'GMT, CLOCK(GMT)>) ;
CHOICE(3) ;

SDAY ← IF GMT GREATERP 24*60 THEN DAY+1 ELSE DAY ;
SGMT ← IF GMT GREATERP 24*60 THEN GMT-24*60 ELSE GMT ;
PRINTSTR("GIVE SIDEREAL TIMES IN THE FORM 174552 FOR 17:45:52") ;
SIDTIMENOON ←
	SECS(RD("SIDEREAL TIME NOON FOR " CAT YEAR CAT MONTHS[MONTH] CAT SDAY)) ;
SIDTIMEG ← SIDTIMENOON + (361*(SGMT-12*60))/6 ;
SIDTIME ← REMAINDER(SIDTIMEG - 240*LONGITUDE, 24*3600) ;
PRINTSTR("LOOK IN THE TABLE OF HOUSES, LATITUDE "
   CAT LATITUDE CAT " N SIDER'L TIMES NEAR " CAT
   SCLOCK(SIDTIME)) ;
SMALLT ← SECS(RD("NEXT SMALLER SIDEREAL TIME")) ;
DO MCS ← RD("SIGN IN 10TH HOUSE") UNTIL MCS.SIGN ;
SMALLMCD ← RD("DEGREES") ;
DO ASCS ← RD("SIGN AT ASCENDANT") UNTIL ASCS.SIGN ;
SMALLASCD ← RD("DEGREES") ; SMALLASCM ← RD("MINUTES") ;
BIGT ← SECS(RD("NEXT LARGER SIDEREAL TIME")) ;
BIGMCD ← SMALLMCD+1 ;
BIGASCD ← RD("DEGREES OF " CAT ASCS CAT " AT ASCENDANT") ;
BIGASCM ← RD("MINUTES") ;
SDAY ← IF GMT LESSP 12*60 THEN DAY-1 ELSE DAY ;
PRINTSTR("NOW TURN TO THE EPHEMERIS FOR " CAT YEAR CAT
   MONTHS[MONTH] CAT SDAY) ;

FOR NEW D ← 1 TO 3 DO
BEGIN
IF D=3 THEN S←RD("TYPE OUTPUT FILENAME OR TTY (OR NIL)") ALSO
	BEGIN IF S NEQ 'TTY THEN EVAL(<'OUTC,<'OUTPUT,'DSK?:,S>>) END
ELSE CHOICE(3) ;
PRINTSTR(CASE D OF BEGIN
   "ENTER NOON POSITIONS OF THE PLANETS (FOR PLUTO, 1ST OF MONTH)";
   "DO THE SAME FOR " CAT MONTHS[MONTH] CAT (SDAY+1);
   "HERE ARE THE NATAL POSITIONS"
   END) ;
FOR NEW P IN '(SUN VENUS MERCURY MOON SATURN JUPITER MARS URANUS
   NEPTUNE PLUTO) DO
   CASE D OF
   BEGIN
   P.PREV ← <DO S←RD(P CAT " SIGN") UNTIL S.SIGN,
      RD("DEGREES"), RD("MINUTES")> ;
   P.NEXT ← <S←CAR(P.PREV),
      RD("DEGREES OF " CAT S CAT " FOR " CAT P), RD("MINUTES")> ;
	BEGIN
	PNEXT ← P.NEXT ; PPREV ← P.PREV ;
	PNATAL ←
	   IF P EQ 'PLUTO THEN INTERP(SDAY, 1, 60*PPREV[2]+PPREV[3],
		LASTDAY[MONTH]+1, 60*PNEXT[2]+PNEXT[3])
	   ELSE INTERP(GMT,
	   	IF GMT LESSP 12*60 THEN -12*60 ELSE 12*60, 60*PPREV[2]+PPREV[3],
		IF GMT LESSP 12*60 THEN 12*60 ELSE 36*60, 60*PNEXT[2]+PNEXT[3]) ;
	TERPRI PRINC(<P, ARC(PNATAL), PPREV[1]>) ;
	END ;
   END ;
END ;
MC ← INTERP(SIDTIME, SMALLT, SMALLMCD*60,
                     BIGT, BIGMCD*60) ;
ASC ← INTERP(SIDTIME, SMALLT, SMALLASCD*60+SMALLASCM,
                      BIGT, BIGASCD*60+BIGASCM) ;
TERPRI PRINC(<'MIDHEAVEN, ARC(MC), MCS>) ;
TERPRI PRINC(<'ASCENDANT, ARC(ASC), ASCS>) ;
TERPRI PRINC(NAME) ;
OUTC(NIL,T);
RD("TYPE `NIL' TO MAKE CORRECTIONS NOW") ;
END ;
EXPR INIT() ;
BEGIN

FOR NEW I ← 4 TO 8 FOR NEW Z IN '(ATLANTIC EASTERN
   CENTRAL MOUNTAIN PACIFIC) DO
   Z.WESTOFGREENWICH ← I ;

FOR NEW I ← 1 TO 12 FOR NEW S IN '(ARIES TAURUS GEMINI
   CANCER LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN AQUARIUS
   PISCES) DO
   S.SIGN ← I ;

FOR NEW I ← 1 TO 12 FOR NEW M IN '((JANUARY JAN)(FEBRUARY FEB)
   (MARCH MAR) (APRIL APR) (MAY) (JUNE) (JULY) (AUGUST AUG)
   (SEPTEMBER SEP) (OCTOBER OCT) (NOVEMBER NOV) (DECEMBER DEC))
	DO FOR NEW MM IN M DO MM.MONTH ← I ;

MONTHS ← <" JANUARY ", " FEBRUARY ", " MARCH ", " APRIL ", " MAY ",
	  " JUNE ", " JULY ", " AUGUST ", " SEPTEMBER ", " OCTOBER ",
	  " NOVEMBER ", " DECEMBER "> ;
LASTDAY ← '(31 28 31 30 31 30 31 31 30 31 30 31) ;

END ;

EXPR INTERP(KEY, PREKEY, PREVAL, POSTKEY, POSTVAL) ;
   ((POSTVAL-PREVAL)*(KEY-PREKEY))/(POSTKEY-PREKEY) + PREVAL ;

EXPR RD(N) ;
   BEGIN
   NEW RDVAL ;
   PRINTSTR(N CAT " = ") ;
   RDVAL ← READ() ;
   IF ¬RDVAL THEN DDPNT() ALSO FAILURE() ;
   RETURN RDVAL ;
   END ;

EXPR ZONECORRECTION(Z) ;
   60*((IF 'DAYLIGHT MEMQ Z THEN 1 ELSE 0)
      +(IF 'WAR MEMQ Z THEN 1 ELSE 0)) ;

EXPR MINS(HR) ; 60*QUOTIENT(HR,100) + REMAINDER(HR,100) ;

EXPR SECS(HR) ; 3600*QUOTIENT(HR,10000) + MINS(REMAINDER(HR,10000)) ;

EXPR CLOCK(MS) ; 100*QUOTIENT(MS,60) + REMAINDER(MS,60) ;

EXPR SCLOCK(SS) ; 10000*QUOTIENT(SS,3600) + CLOCK(REMAINDER(SS,3600)) ;

EXPR ARC(MS) ; (QUOTIENT(MS,60)) CAT "⊗ " CAT REMAINDER(MS,60) CAT "'" ;

EXPR CHOICE(N) ;
   SELECT II FROM II:1 SUCCESSOR II+1 UNLESS II GREATERP N FINALLY FAILURE() ;

_EOF_